Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

104

Games Picked

162

Number of predictions

78

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Baltimore Ravens Baltimore Ravens Yes 56 0.7179
2 Detroit Lions Detroit Lions Yes 75 0.9615
3 Houston Texans Houston Texans Yes 69 0.8846
4 Dallas Cowboys Dallas Cowboys Yes 77 0.9872
5 Los Angeles Chargers Green Bay Packers No 22 0.2821
6 Miami Dolphins Miami Dolphins Yes 74 0.9487
7 Washington Commanders New York Giants No 8 0.1026
8 Pittsburgh Steelers Cleveland Browns No 37 0.4744
9 Jacksonville Jaguars Jacksonville Jaguars Yes 76 0.9744
10 San Francisco 49ers San Francisco 49ers Yes 77 0.9872
11 Buffalo Bills Buffalo Bills Yes 69 0.8846
12 Seattle Seahawks Los Angeles Rams No 9 0.1154
13 Minnesota Vikings Denver Broncos No 22 0.2821
14 Kansas City Chiefs Philadelphia Eagles No 34 0.4359

Individual Predictions

row

Individual Table

Individual Results
Week 11
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11
Brian Patterson 10 10 8 11 7 11 5 10 10 8 11 0.7857 11 0.6235 0.6235
Paul Shim 10 9 10 11 7 9 4 10 10 8 11 0.7857 11 0.6111 0.6111
Eric Hahn 9 13 7 9 8 10 6 9 10 6 11 0.7857 11 0.6049 0.6049
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 11 0.7857 10 0.5986 0.5442
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 11 0.7857 10 0.5822 0.5293
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 10 0.7143 7 0.6762 0.4303
George Sweet 9 11 10 12 7 10 10 NA 11 8 10 0.7143 10 0.6712 0.6102
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 10 0.7143 9 0.6642 0.5434
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 10 0.7143 11 0.6420 0.6420
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 10 0.7143 10 0.6395 0.5814
Jason Schattel 7 10 9 11 9 10 3 13 12 9 10 0.7143 11 0.6358 0.6358
James Small 8 8 13 9 8 10 8 10 12 6 10 0.7143 11 0.6296 0.6296
Montee Brown 7 NA NA 9 9 11 6 12 11 8 10 0.7143 9 0.6288 0.5145
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 10 0.7143 11 0.6235 0.6235
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 10 0.7143 11 0.6173 0.6173
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 10 0.7143 10 0.6164 0.5604
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 10 0.7143 11 0.6049 0.6049
Yiming Hu 9 10 8 12 7 9 6 9 10 8 10 0.7143 11 0.6049 0.6049
Kevin Green 9 12 9 9 8 9 7 NA NA 6 10 0.7143 9 0.5985 0.4897
Pamela AUGUSTINE 11 13 6 9 6 9 5 10 9 NA 10 0.7143 10 0.5946 0.5405
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 10 0.7143 11 0.5926 0.5926
Daniel Baller 6 12 11 9 8 9 3 10 8 9 10 0.7143 11 0.5864 0.5864
WAYNE SCHOFIELD 12 9 7 NA 8 NA 5 10 7 NA 10 0.7143 8 0.5812 0.4227
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 10 0.7143 10 0.5811 0.5283
Kristen White 7 13 8 11 6 7 7 10 8 6 10 0.7143 11 0.5741 0.5741
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 10 0.7143 11 0.5741 0.5741
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 10 0.7143 8 0.5726 0.4164
Steven Webster 8 8 6 8 9 8 6 10 10 8 10 0.7143 11 0.5617 0.5617
Justin Thrift 9 8 9 8 9 7 5 11 7 6 10 0.7143 11 0.5494 0.5494
Justin Crick 11 11 11 13 8 11 4 11 11 8 9 0.6429 11 0.6667 0.6667
William Schouviller 10 9 11 10 8 9 NA 13 10 9 9 0.6429 10 0.6577 0.5979
James Tierney 9 10 NA 10 10 12 7 10 8 9 9 0.6429 10 0.6351 0.5774
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 9 0.6429 9 0.6288 0.5145
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 9 0.6429 10 0.6284 0.5713
James Blejski 8 11 10 14 NA 9 7 12 7 6 9 0.6429 10 0.6284 0.5713
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 9 0.6429 11 0.6235 0.6235
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 9 0.6429 10 0.6164 0.5604
Michael Moss 10 NA 11 13 7 9 4 10 9 8 9 0.6429 10 0.6164 0.5604
Terry Hardison 10 10 9 11 7 9 4 11 9 10 9 0.6429 11 0.6111 0.6111
George Mancini 7 12 10 10 9 10 6 NA 7 9 9 0.6429 10 0.6096 0.5542
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 9 0.6429 10 0.6081 0.5528
Donald Park 8 12 7 9 NA NA 6 10 11 NA 9 0.6429 8 0.6050 0.4400
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 9 0.6429 10 0.6027 0.5479
Daniel Major 8 13 6 7 8 11 7 11 NA NA 9 0.6429 9 0.5970 0.4885
Paul Presti 9 10 12 9 8 9 5 8 NA 9 9 0.6429 10 0.5946 0.5405
John Plaster 8 12 8 10 NA NA 6 9 7 10 9 0.6429 9 0.5940 0.4860
Robert Gelo 6 9 10 10 9 11 5 11 6 9 9 0.6429 11 0.5864 0.5864
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 9 0.6429 10 0.5850 0.5318
DAVID PLATE 8 NA 8 9 8 10 5 9 11 8 9 0.6429 10 0.5822 0.5293
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 9 0.6429 8 0.5812 0.4227
Shawn Carden 9 12 6 9 8 9 5 10 9 8 9 0.6429 11 0.5802 0.5802
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 9 0.6429 9 0.5455 0.4463
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 9 0.6429 6 0.5412 0.2952
Robert Lynch 9 9 6 10 10 6 4 9 10 5 9 0.6429 11 0.5370 0.5370
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 9 0.6429 8 0.5172 0.3761
Trevor MACGAVIN 6 10 8 NA 6 7 4 NA 6 6 9 0.6429 9 0.4769 0.3902
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 9 0.6429 11 0.4691 0.4691
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 8 0.5714 10 0.6531 0.5937
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 8 0.5714 5 0.6486 0.2948
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 8 0.5714 11 0.6420 0.6420
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 8 0.5714 11 0.6173 0.6173
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 8 0.5714 11 0.6049 0.6049
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 8 0.5714 11 0.6049 0.6049
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 8 0.5714 10 0.5946 0.5405
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 8 0.5714 11 0.5926 0.5926
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 8 0.5714 9 0.5926 0.4849
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 8 0.5714 11 0.5926 0.5926
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 8 0.5714 8 0.5714 0.4156
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 8 0.5714 9 0.5606 0.4587
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 7 0.5000 11 0.6111 0.6111
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 7 0.5000 11 0.6111 0.6111
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 7 0.5000 11 0.5802 0.5802
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 7 0.5000 7 0.5728 0.3645
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 7 0.5000 10 0.5616 0.5105
Amy Asberry 8 9 10 9 9 8 5 10 6 9 7 0.5000 11 0.5556 0.5556
Steven Curtis NA NA 11 7 8 10 6 7 8 7 7 0.5000 9 0.5462 0.4469
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 7 0.5000 10 0.5411 0.4919
DERRICK ELAM 6 9 11 10 10 7 NA 5 7 7 6 0.4286 10 0.5235 0.4759
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA NA 0.0000 4 0.6774 0.2463
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA NA 0.0000 6 0.6522 0.3557
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.6250 0.0568
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 NA 0.0000 8 0.6186 0.4499
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 NA 0.0000 10 0.5878 0.5344
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA NA 0.0000 7 0.5769 0.3671
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA NA 0.0000 3 0.5625 0.1534
Jason James 9 NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0511
Michael Beck 9 NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0511
THOMAS MCCOY 8 10 9 7 8 9 7 11 7 7 NA 0.0000 10 0.5608 0.5098
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 NA 0.0000 10 0.5541 0.5037
Min Choi 6 7 9 11 7 10 5 13 7 5 NA 0.0000 10 0.5405 0.4914
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA NA 0.0000 7 0.5385 0.3427
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA NA 0.0000 2 0.5000 0.0909
Edward Ford 6 8 NA NA NA NA NA NA NA NA NA 0.0000 2 0.4375 0.0795

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 11
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Michael Edmunds 0 4 0.6774 0.2463
2 Stephen Woolwine 1 7 0.6762 0.4303
3 George Sweet 1 10 0.6712 0.6102
4 Justin Crick 0 11 0.6667 0.6667
5 Antonio Mitchell 1 9 0.6642 0.5434
6 William Schouviller 1 10 0.6577 0.5979
7 Sarah Sweet 0 10 0.6531 0.5937
8 Kevin O'NEILL 0 6 0.6522 0.3557
9 Keithon Corpening 0 5 0.6486 0.2948
10 Chris Papageorge 0 11 0.6420 0.6420
10 Ryan Wiggins 0 11 0.6420 0.6420
12 Vincent Scannelli 0 10 0.6395 0.5814
13 Jason Schattel 1 11 0.6358 0.6358
14 James Tierney 2 10 0.6351 0.5774
15 James Small 1 11 0.6296 0.6296
16 Montee Brown 0 9 0.6288 0.5145
16 Shelly Bailey 1 9 0.6288 0.5145
18 Gabriel Quinones 0 10 0.6284 0.5713
18 James Blejski 1 10 0.6284 0.5713
20 Carlos Caceres 0 1 0.6250 0.0568
21 Anthony Bloss 1 11 0.6235 0.6235
21 Brian Patterson 1 11 0.6235 0.6235
21 PABLO BURGOSRAMOS 1 11 0.6235 0.6235
24 Ramar Williams 0 8 0.6186 0.4499
25 MICHAEL BRANSON 0 11 0.6173 0.6173
25 Ryan Cvik 0 11 0.6173 0.6173
27 Bradley Hobson 0 10 0.6164 0.5604
27 Cody Koerwitz 0 10 0.6164 0.5604
27 Michael Moss 0 10 0.6164 0.5604
30 Aubrey Conn 0 11 0.6111 0.6111
30 Paul Shim 1 11 0.6111 0.6111
30 Ronald Schmidt 1 11 0.6111 0.6111
30 Terry Hardison 0 11 0.6111 0.6111
34 George Mancini 0 10 0.6096 0.5542
35 Karen Coleman 2 10 0.6081 0.5528
36 Donald Park 0 8 0.6050 0.4400
37 Brian Hollmann 2 11 0.6049 0.6049
37 Bunnaro Sun 0 11 0.6049 0.6049
37 Cheryl Brown 0 11 0.6049 0.6049
37 Eric Hahn 2 11 0.6049 0.6049
37 Yiming Hu 0 11 0.6049 0.6049
42 Matthew Schultz 0 10 0.6027 0.5479
43 Patrick Tynan 1 10 0.5986 0.5442
44 Kevin Green 0 9 0.5985 0.4897
45 Daniel Major 1 9 0.5970 0.4885
46 Pamela AUGUSTINE 1 10 0.5946 0.5405
46 Paul Presti 0 10 0.5946 0.5405
46 Walter Archambo 0 10 0.5946 0.5405
49 John Plaster 0 9 0.5940 0.4860
50 Anthony Brinson 1 11 0.5926 0.5926
50 Charlene Redmer 0 9 0.5926 0.4849
50 Jonathon Leslein 0 11 0.5926 0.5926
50 Kevin Kehoe 0 11 0.5926 0.5926
54 Shaun Dahl 1 10 0.5878 0.5344
55 Daniel Baller 0 11 0.5864 0.5864
55 Robert Gelo 0 11 0.5864 0.5864
57 Earl Dixon 0 10 0.5850 0.5318
58 DAVID PLATE 0 10 0.5822 0.5293
58 Thomas Brenstuhl 1 10 0.5822 0.5293
60 WAYNE SCHOFIELD 1 8 0.5812 0.4227
60 William Sherman 0 8 0.5812 0.4227
62 Stephen Bush 0 10 0.5811 0.5283
63 Manuel Vargas 0 11 0.5802 0.5802
63 Shawn Carden 0 11 0.5802 0.5802
65 Rahmatullah Sharifi 0 7 0.5769 0.3671
66 Daniel Kuehl 0 11 0.5741 0.5741
66 Kristen White 1 11 0.5741 0.5741
68 Daniel Halse 0 7 0.5728 0.3645
69 Rafael Torres 0 8 0.5726 0.4164
70 Gregory Flint 0 8 0.5714 0.4156
71 Jamal Willis 0 3 0.5625 0.1534
71 Jason James 0 1 0.5625 0.0511
71 Michael Beck 0 1 0.5625 0.0511
74 Steven Webster 0 11 0.5617 0.5617
75 Khalil Ibrahim 0 10 0.5616 0.5105
76 THOMAS MCCOY 0 10 0.5608 0.5098
77 Brandon Parks 0 9 0.5606 0.4587
78 Amy Asberry 0 11 0.5556 0.5556
79 Cherylynn Vidal 0 10 0.5541 0.5037
80 Justin Thrift 0 11 0.5494 0.5494
81 Steven Curtis 0 9 0.5462 0.4469
82 Robert Martin 0 9 0.5455 0.4463
83 David Spielman 0 6 0.5412 0.2952
84 Alexander Santillan 0 10 0.5411 0.4919
85 Min Choi 1 10 0.5405 0.4914
86 Derrick Zantt 0 7 0.5385 0.3427
87 Robert Lynch 1 11 0.5370 0.5370
88 DERRICK ELAM 1 10 0.5235 0.4759
89 Melissa Printup 1 8 0.5172 0.3761
90 TYREE BUNDY 0 2 0.5000 0.0909
91 Trevor MACGAVIN 0 9 0.4769 0.3902
92 Ryan Shipley 0 11 0.4691 0.4691
93 Edward Ford 0 2 0.4375 0.0795

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 11
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 11 0.6667 0.6667
2 Chris Papageorge 0 11 0.6420 0.6420
2 Ryan Wiggins 0 11 0.6420 0.6420
4 Jason Schattel 1 11 0.6358 0.6358
5 James Small 1 11 0.6296 0.6296
6 Anthony Bloss 1 11 0.6235 0.6235
6 Brian Patterson 1 11 0.6235 0.6235
6 PABLO BURGOSRAMOS 1 11 0.6235 0.6235
9 MICHAEL BRANSON 0 11 0.6173 0.6173
9 Ryan Cvik 0 11 0.6173 0.6173
11 Aubrey Conn 0 11 0.6111 0.6111
11 Paul Shim 1 11 0.6111 0.6111
11 Ronald Schmidt 1 11 0.6111 0.6111
11 Terry Hardison 0 11 0.6111 0.6111
15 George Sweet 1 10 0.6712 0.6102
16 Brian Hollmann 2 11 0.6049 0.6049
16 Bunnaro Sun 0 11 0.6049 0.6049
16 Cheryl Brown 0 11 0.6049 0.6049
16 Eric Hahn 2 11 0.6049 0.6049
16 Yiming Hu 0 11 0.6049 0.6049
21 William Schouviller 1 10 0.6577 0.5979
22 Sarah Sweet 0 10 0.6531 0.5937
23 Anthony Brinson 1 11 0.5926 0.5926
23 Jonathon Leslein 0 11 0.5926 0.5926
23 Kevin Kehoe 0 11 0.5926 0.5926
26 Daniel Baller 0 11 0.5864 0.5864
26 Robert Gelo 0 11 0.5864 0.5864
28 Vincent Scannelli 0 10 0.6395 0.5814
29 Manuel Vargas 0 11 0.5802 0.5802
29 Shawn Carden 0 11 0.5802 0.5802
31 James Tierney 2 10 0.6351 0.5774
32 Daniel Kuehl 0 11 0.5741 0.5741
32 Kristen White 1 11 0.5741 0.5741
34 Gabriel Quinones 0 10 0.6284 0.5713
34 James Blejski 1 10 0.6284 0.5713
36 Steven Webster 0 11 0.5617 0.5617
37 Bradley Hobson 0 10 0.6164 0.5604
37 Cody Koerwitz 0 10 0.6164 0.5604
37 Michael Moss 0 10 0.6164 0.5604
40 Amy Asberry 0 11 0.5556 0.5556
41 George Mancini 0 10 0.6096 0.5542
42 Karen Coleman 2 10 0.6081 0.5528
43 Justin Thrift 0 11 0.5494 0.5494
44 Matthew Schultz 0 10 0.6027 0.5479
45 Patrick Tynan 1 10 0.5986 0.5442
46 Antonio Mitchell 1 9 0.6642 0.5434
47 Pamela AUGUSTINE 1 10 0.5946 0.5405
47 Paul Presti 0 10 0.5946 0.5405
47 Walter Archambo 0 10 0.5946 0.5405
50 Robert Lynch 1 11 0.5370 0.5370
51 Shaun Dahl 1 10 0.5878 0.5344
52 Earl Dixon 0 10 0.5850 0.5318
53 DAVID PLATE 0 10 0.5822 0.5293
53 Thomas Brenstuhl 1 10 0.5822 0.5293
55 Stephen Bush 0 10 0.5811 0.5283
56 Montee Brown 0 9 0.6288 0.5145
56 Shelly Bailey 1 9 0.6288 0.5145
58 Khalil Ibrahim 0 10 0.5616 0.5105
59 THOMAS MCCOY 0 10 0.5608 0.5098
60 Cherylynn Vidal 0 10 0.5541 0.5037
61 Alexander Santillan 0 10 0.5411 0.4919
62 Min Choi 1 10 0.5405 0.4914
63 Kevin Green 0 9 0.5985 0.4897
64 Daniel Major 1 9 0.5970 0.4885
65 John Plaster 0 9 0.5940 0.4860
66 Charlene Redmer 0 9 0.5926 0.4849
67 DERRICK ELAM 1 10 0.5235 0.4759
68 Ryan Shipley 0 11 0.4691 0.4691
69 Brandon Parks 0 9 0.5606 0.4587
70 Ramar Williams 0 8 0.6186 0.4499
71 Steven Curtis 0 9 0.5462 0.4469
72 Robert Martin 0 9 0.5455 0.4463
73 Donald Park 0 8 0.6050 0.4400
74 Stephen Woolwine 1 7 0.6762 0.4303
75 WAYNE SCHOFIELD 1 8 0.5812 0.4227
75 William Sherman 0 8 0.5812 0.4227
77 Rafael Torres 0 8 0.5726 0.4164
78 Gregory Flint 0 8 0.5714 0.4156
79 Trevor MACGAVIN 0 9 0.4769 0.3902
80 Melissa Printup 1 8 0.5172 0.3761
81 Rahmatullah Sharifi 0 7 0.5769 0.3671
82 Daniel Halse 0 7 0.5728 0.3645
83 Kevin O'NEILL 0 6 0.6522 0.3557
84 Derrick Zantt 0 7 0.5385 0.3427
85 David Spielman 0 6 0.5412 0.2952
86 Keithon Corpening 0 5 0.6486 0.2948
87 Michael Edmunds 0 4 0.6774 0.2463
88 Jamal Willis 0 3 0.5625 0.1534
89 TYREE BUNDY 0 2 0.5000 0.0909
90 Edward Ford 0 2 0.4375 0.0795
91 Carlos Caceres 0 1 0.6250 0.0568
92 Jason James 0 1 0.5625 0.0511
92 Michael Beck 0 1 0.5625 0.0511

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 11 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
# week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
# week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
# week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
# week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
# week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
# week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
# week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
# week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
# week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11) #, week_12, week_13, week_14, week_15, week_16, week_17, week_18, week_19, week_20, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```